(defpackage :calculator
  (:use :cl)
  (:nicknames :calc)
  (:export :calculator))

(in-package :calculator)

(defstruct (calc-state (:conc-name cs-))
  op n1 n2 (state 'start))

(defvar *width* 30)
(defvar *height* 30)

(gwee:define-component calculator ()
  ((state :initform (make-calc-state) :accessor calculator-state))
  (:views
   (input gwee:text-area
          :data "0"
          :width :maximum
          :height :maximum
          :border-color gwee:*default-foreground-color*
          :vertical-justification :center
          :horizontal-justification :right
          :right-padding 3)
   (b1 gwee:button :data "1" :width *width* :height *height* :callback-data '(:number 1) :click-callback 'click)
   (b2 gwee:button :data "2" :width *width* :height *height* :callback-data '(:number 2) :click-callback 'click)
   (b3 gwee:button :data "3" :width *width* :height *height* :callback-data '(:number 3) :click-callback 'click)
   (b4 gwee:button :data "4" :width *width* :height *height* :callback-data '(:number 4) :click-callback 'click)
   (b5 gwee:button :data "5" :width *width* :height *height* :callback-data '(:number 5) :click-callback 'click)
   (b6 gwee:button :data "6" :width *width* :height *height* :callback-data '(:number 6) :click-callback 'click)
   (b7 gwee:button :data "7" :width *width* :height *height* :callback-data '(:number 7) :click-callback 'click)
   (b8 gwee:button :data "8" :width *width* :height *height* :callback-data '(:number 8) :click-callback 'click)
   (b9 gwee:button :data "9" :width *width* :height *height* :callback-data '(:number 9) :click-callback 'click)
   (b0 gwee:button :data "0" :width *width* :height *height* :callback-data '(:number 0) :click-callback 'click)
   (b+ gwee:button :data "+" :width *width* :height *height* :callback-data '(:op +) :click-callback 'click)
   (b- gwee:button :data (string (code-char 8722)) :width *width* :height *height* :callback-data '(:op -) :click-callback 'click)
   (b* gwee:button :data (string (code-char 215)) :width *width* :height *height* :callback-data '(:op *) :click-callback 'click)
   (b/ gwee:button :data (string (code-char 247)) :width *width* :height *height* :callback-data '(:op /) :click-callback 'click)
   (minus gwee:button :data (string (code-char 177)) :width *width* :height *height* :callback-data '(:minus nil) :click-callback 'click)
   (equals gwee:button :data "=" :width (+ 6 (* *width* 2)) :height *height* :callback-data '(:op =) :click-callback 'click)
   (clear gwee:button :data "C" :width (+ 6 (* *width* 2)) :height *height* :callback-data '(:clear nil) :click-callback 'click)
   (bfraction gwee:button :data "/" :width *width* :height *height* :callback-data '(:divider nil) :click-callback 'click))
  (:layouts
   (default gwee:column-layout
       (input row0 row1 row2 row3 row4)
     :border-color gwee:*default-foreground-color*
     :border-left nil
     :padding 3
     :margin 5)
   (row0 gwee:row-layout (clear minus b* ) :padding 6)
   (row1 gwee:row-layout (b7 b8 b9 b/) :padding 6)
   (row2 gwee:row-layout (b4 b5 b6 b-) :padding 6)
   (row3 gwee:row-layout (b1 b2 b3 b+) :padding 6)
   (row4 gwee:row-layout (b0 bfraction equals) :padding 6))
  (:default-initargs
      :width 158 :height 204))
 
(defun glob-number (n)
  "Given the N, list representing a number return it as a number"
  (when (eq (car (last n)) '/)
    (setf n (butlast n)))
  (when (equal n '(-))
    (setf n '(0)))
  (read-from-string (apply 'concatenate 'string (mapcar 'prin1-to-string n))))

(defun text-to-display (state)
  (apply 'concatenate
         'string
         (mapcar 'prin1-to-string 
                 (ecase (cs-state state)
                   (start '(0))
                   ((number-1 number-1-denominator equal)
                    (or (cs-n1 state)
                        '(0)))
                   ((number-2 number-2-denominator)
                    (or (cs-n2 state)
                        (cs-n1 state)))))))

(defun click (b)
  (with-slots (state input) (gwee:component-for-view b)
    (apply 'state-advance state (gwee:callback-data b))
    (setf (gwee:view-data input) (text-to-display state)
          (gwee:view-needs-update-p input) t)
    (exp:lg 'calculator :button (gwee:view-data b) :display (gwee:view-data input))))

(defun log-op (op arg clickp)
  (ecase op
    ((:number :op) (exp:log 'calc :button arg :clickp clickp))
    (:minus (exp:log 'calc :button :minus :clickp clickp))
    (:divider (exp:log 'calc :button :divider :clickp clickp))
    (:clear (exp:log 'calc :button :clear :clickp clickp))))

(defun do-opn (op n1 n2)
  (let ((result (funcall op n1 n2)))
    (if (< result 0)
        (list '- (abs result))
      (list result))))

(defun state-advance (state action arg)
  "Given an action and argument, move STATE forward by performing the
action. STATE is modified."
  (if (eq action :clear)
      (setf (cs-state state) 'start)
    (ecase (cs-state state)
      (start
       (ecase action
         (:op )
         (:number
          (setf (cs-n1 state) (list arg)
                (cs-state state) 'number-1))
         (:minus 
          (if (eq (car (cs-n1 state)) '-)
              (pop (cs-n1 state))
            (push '- (cs-n1 state)))
          (setf (cs-state state) 'number-1))
         (:divider
          (setf (cs-n1 state) (list 1 '/)
                (cs-state state) 'number-1-denominator))))
      (number-1
       (ecase action
         (:op
          (unless (eq arg '=)
            (setf (cs-op state) arg
                  (cs-n2 state) nil
                  (cs-state state) 'number-2)))
         (:number
          (setf (cs-n1 state) (append (cs-n1 state) (list arg))))
         (:minus 
          (if (eq (car (cs-n1 state)) '-)
              (pop (cs-n1 state))
            (push '- (cs-n1 state))))
         (:divider
          (cond ((null (cs-n1 state))
                 (setf (cs-n1 state) (list 1 '/)))
                ((equal (cs-n1 state) '(-))
                 (setf (cs-n1 state) (list '- 1 '/)))
                (t (setf (cs-n1 state) (append (cs-n1 state) (list '/)))))
          (setf (cs-state state) 'number-1-denominator))))
      (number-1-denominator
       (ecase action
         (:op
          (unless (or (eq arg '=)
                      (eq (cdr (last (cs-n1 state))) '/)
                      (and (cs-n1 state)
                           (equal (list (nth (- (length (cs-n1 state)) 2) (cs-n1 state))
                                        (nth (1- (length (cs-n1 state))) (cs-n1 state)))
                                  '(/ 0))))
            (setf (cs-op state) arg
                  (cs-n2 state) nil
                  (cs-state state) 'number-2)))
         (:number
          (setf (cs-n1 state) (append (cs-n1 state) (list arg))))
         (:minus 
          (if (eq (car (cs-n1 state)) '-)
              (pop (cs-n1 state))
            (push '- (cs-n1 state))))
         (:divider ;; do nothing
          )))
      (number-2
       (ecase action
         (:op
          ;; just change the operator if we haven't typed a number yet.
          (if (null (cs-n2 state))
              (unless (eq arg '=)
                (setf (cs-op state) arg))
            (let ((result (do-opn (cs-op state) 
                                  (glob-number (cs-n1 state))
                                  (glob-number (cs-n2 state)))))
              (if (eq arg '=)
                  (setf (cs-n1 state) result
                        (cs-state state) 'equal)
                (setf (cs-n1 state) result
                      (cs-op state) arg
                      (cs-n2 state) nil)))))
          (:number
          (setf (cs-n2 state) (append (cs-n2 state) (list arg))))
         (:minus 
          (if (eq (car (cs-n2 state)) '-)
              (pop (cs-n2 state))
            (push '- (cs-n2 state))))
         (:divider
          (cond ((null (cs-n2 state))
                 (setf (cs-n2 state) (list 1 '/)))
                ((equal (cs-n2 state) '(-))
                 (setf (cs-n2 state) (list '- 1 '/)))
                (t (setf (cs-n2 state) (append (cs-n2 state) (list '/)))))
          (setf (cs-state state) 'number-2-denominator))))
      (number-2-denominator
       (ecase action
         (:op
          (unless (or (eq (cdr (last (cs-n2 state))) '/)
                      (and (cs-n2 state)
                           (equal (list (nth (- (length (cs-n2 state)) 2) (cs-n2 state))
                                        (nth (1- (length (cs-n2 state))) (cs-n2 state)))
                                  '(/ 0))))
          (let ((result (do-opn (cs-op state) 
                                (glob-number (cs-n1 state))
                                (glob-number (cs-n2 state)))))
            (if (eq arg '=)
                (setf (cs-n1 state) result
                      (cs-state state) 'equal)
              (setf (cs-n1 state) result
                    (cs-op state) arg
                    (cs-n2 state) nil
                    (cs-state state) 'number-2)))))
         (:number
          (setf (cs-n2 state) (append (cs-n2 state) (list arg))))
         (:minus 
          (if (eq (car (cs-n2 state)) '-)
              (pop (cs-n2 state))
            (push '- (cs-n2 state))))
         (:divider ;; do nothing
          )))
      (equal
       (ecase action
         (:op
          (unless (eq arg '=)
            (setf (cs-op state) arg
                  (cs-n2 state) nil
                  (cs-state state) 'number-2)))
         (:minus 
          (if (eq (car (cs-n1 state)) '-)
              (pop (cs-n1 state))
            (push '- (cs-n1 state))))
         (:divider
          (setf (cs-n1 state) (list 1 '/)
                (cs-state state) 'number-1-denominator))
         (:number
          (setf (cs-n1 state) (list arg)
                (cs-state state) 'number-1)))))))

(defun safe-/ (&rest args)
  (or (ignore-errors (apply #'/ args))
      0))
